Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
Syntax10b.Scn.Fnt
MODULE Diskette;	(* Marc Pilloud, 19. Apr 94 *) 
IMPORT
	SYSTEM, Amiga, MFM := AmigaMFM, Exec := AmigaExec, 
	Files, Kernel;
(* ORIGINAL OBERON TYPES *)
FileDesc =   RECORD                    (* image of dir entry *)
               name:ARRAY 22 OF CHAR;    (* size(FileDesc)  = 32 Byte *)
               time,date:INTEGER;
               head:INTEGER;
               size:LONGINT
             END;
  File       = POINTER TO FileHandle;
  FileHandle = RECORD
                 prev,next:File;
                 file:FileDesc
               END;
  EntryHandler* = PROCEDURE(name:ARRAY OF CHAR; date, time, size:LONGINT);
  MFMPtr = POINTER TO MFM.IOExtMFM;
CONST
(* AMIGA VERSION CONST  *)
  ON  = TRUE;
  OFF = FALSE;
  tries = 3;                      (* Anzahl Versuch ein Kommando auszufhren *)
  sectorSize = LONG(MFM.sector);
  trackSize  = LONG(MFM.numSecs*MFM.sector);        (* 9 sectors * 512 Bytes *)
(* ORIGINAL OBERON CONST *)
  Oberon* = 0E9X;
  MSDOS*  = 0F9X;
(* AMIGA VERSION VAR *)
  mfmPortLI  : Exec.MsgPortPtr;
  mfmioLI      : MFM.IOExtMFMPtr;
  mfmOpen   : BOOLEAN;
  unit            : LONGINT;
  update       : BOOLEAN; (*IF update    THEN nach jedem PutSector Daten zurckschreiben *)
  stopMotor : BOOLEAN; (*IF stopMotor THEN nach jedem Put-,GetSector Motor abschalten *)
  err*            : LONGINT;
(* ORIGINAL OBERON VAR *)
  res*    :INTEGER; (* result of file-oriented operation, error = ( res # 0) *)
  sect*   :LONGINT;
  busy*   :BOOLEAN; (* state of device driver                                *)
  dir     : File;
  trailer : FileDesc;
  usedF, usedC : INTEGER;
  FAT     : ARRAY 720 OF INTEGER;
(*===========================================================================*)
(*                             DEVICE DRIVER                                 *)
(*===========================================================================*)
(*****************************************************************************)
(*                                CLOSE                                      *)
(*****************************************************************************)
PROCEDURE Close*;
BEGIN
  IF mfmOpen THEN Exec.CloseDevice(mfmioLI); mfmOpen := FALSE END;
  IF mfmPortLI # 0 THEN Exec.DeleteMsgPort(mfmPortLI); mfmPortLI:=0 END;
  IF mfmioLI # 0 THEN Exec.DeleteIORequest(mfmioLI); mfmioLI:=0 END
END Close;
(*****************************************************************************)
(*                               SET DRIVE                                                     *)
(*****************************************************************************)
PROCEDURE SetDrive*(unitNr:LONGINT);
  VAR mfmio:MFMPtr;
BEGIN
  mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);             (* Type cast *)
  IF (unitNr >= 0) & (unitNr <= 3) & ((unit#unitNr) OR (~mfmOpen)) THEN
    unit := unitNr;
    IF mfmPortLI = 0 THEN mfmPortLI := Exec.CreateMsgPort() END;
    IF mfmPortLI = 0 THEN HALT(50) END;
    IF mfmioLI = 0 THEN 
        mfmioLI := Exec.CreateIORequest(mfmPortLI, SIZE(MFM.IOExtMFM)); 
        mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);             (* Type cast *)
    END;
    IF mfmioLI   = 0 THEN HALT(50) END;
    IF mfmOpen THEN Exec.CloseDevice(mfmioLI) END;  (* Altes Device schliessen *)
    mfmOpen:= (Exec.OpenDevice(MFM.name,unit,mfmioLI,{})=0)
                   & (mfmio.req.error=0);               (* Neues Device ffnen     *)
  END;
  IF ~mfmOpen THEN HALT(50) END;
END SetDrive;
(*****************************************************************************)
(*                        DoCommand and Error Handling                          *)
(*****************************************************************************)
PROCEDURE DoCommand(com:INTEGER):LONGINT;
  VAR try:SHORTINT;
         mfmio:MFMPtr;
BEGIN
  mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);             (* Type cast *)
  busy := TRUE;
  mfmio.req.command:=com;
  try := 1;
  REPEAT
    err := Exec.DoIO(mfmioLI);
    INC(try)
  UNTIL (err=0) OR (try>tries);
  IF err#0 THEN
   IF (err#23) & (err#28) THEN HALT(51) END;
  ELSE busy := FALSE
  END;
  RETURN err
END DoCommand;
(*****************************************************************************)
(*            GetDiskChanges, StopMotor, ClearBuf, Update                 *)
(*****************************************************************************)
PROCEDURE GetDiskChanges():LONGINT;
   VAR mfmio:MFMPtr;
BEGIN
  mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  mfmio.req.command:=MFM.changeNum;
  IF Exec.DoIO(mfmioLI)#0 THEN HALT(51) END;
  RETURN (mfmio.req.actual)
END GetDiskChanges;
PROCEDURE StopMotor;
  VAR mfmio:MFMPtr;
BEGIN
  mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  mfmio.req.length:=0;
  mfmio.req.command:=MFM.motor;
  IF Exec.DoIO(mfmioLI)#0 THEN HALT(51) END
END StopMotor;
PROCEDURE ClearBuf;
  VAR mfmio:MFMPtr;
BEGIN
 mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
 mfmio.req.command:=MFM.extClear;
 IF Exec.DoIO(mfmioLI)#0 THEN HALT(51) END
END ClearBuf;
PROCEDURE Update;
BEGIN
 IF DoCommand(MFM.extUpdate)#0 THEN HALT(53) END
END Update;
(*****************************************************************************)
(*                               RESET                                       *)
(*****************************************************************************)
PROCEDURE Reset*;
  VAR mfmio:MFMPtr;
BEGIN
  mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  mfmio.secLabel := 0;                (* Sektor-Label wird nicht verwendet *)
  mfmio.count    := GetDiskChanges();   (* Diskwechselzhler setzten         *)
  StopMotor;                            (* Motor abschalten                  *)
  ClearBuf;                             (* Interner DiskBuffer lschen       *)
  stopMotor := ON; update := ON;
END Reset;
(*****************************************************************************)
(*                                 GetSector                                 *)
(*****************************************************************************)
PROCEDURE GetSector*(sec:INTEGER; VAR buf:ARRAY OF SYSTEM.BYTE; off:INTEGER);
  VAR oldcount:LONGINT;
         mfmio:MFMPtr;
BEGIN
  mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  IF busy THEN Reset END;
  sect        := sec;
  oldcount    := mfmio.count;
  mfmio.count := GetDiskChanges();
  IF oldcount # mfmio.count THEN ClearBuf END;
  mfmio.req.offset := sec*sectorSize;
  mfmio.req.data   := SYSTEM.ADR(buf[off]);
  mfmio.req.length := sectorSize;
  IF DoCommand(MFM.extRead)#0 THEN HALT(52) END;
  IF stopMotor THEN StopMotor END;
END GetSector;
(*****************************************************************************)
(*                              PUT SECTOR                                   *)
(*****************************************************************************)
PROCEDURE PutSector*(sec:INTEGER; VAR buf:ARRAY OF SYSTEM.BYTE; off:INTEGER);
   VAR mfmio:MFMPtr;
BEGIN
  mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  IF busy THEN Reset END;
  sect             := sec;
  mfmio.count      := GetDiskChanges();
  mfmio.req.offset := sec*sectorSize;
  mfmio.req.data   := SYSTEM.ADR(buf[off]);
  mfmio.req.length := sectorSize;
  IF DoCommand(MFM.extWrite)#0 THEN HALT(53) END;
  IF update    THEN Update    END;
  IF stopMotor THEN StopMotor END;
END PutSector;
(*****************************************************************************)
(*                               FORMAT                                      *)
(*****************************************************************************)
PROCEDURE Format*;
  VAR c:INTEGER;
         buf: ARRAY trackSize OF SYSTEM.BYTE;
         mfmio:MFMPtr;
BEGIN
  mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  IF busy THEN Reset END;
  c:=0; WHILE c<trackSize DO buf[c]:=SYSTEM.VAL(SYSTEM.BYTE,0E5H); INC(c) END;
  c:=0;
  WHILE c < 160 DO
    mfmio.count      := GetDiskChanges();
    mfmio.req.offset := c*trackSize;                         (* Track Nummer *)
    mfmio.req.data   := SYSTEM.ADR(buf[0]);
    mfmio.req.length := trackSize;
    IF DoCommand(MFM.extFormat)#0 THEN HALT(51) END;
    INC(c);
  END;
  StopMotor;                                             (* Motor abschalten *)
END Format;
(*===========================================================================*)
(*                            DIRECTORY PROCEDURES                           *)
(*===========================================================================*)
(*****************************************************************************)
(*           COPY AND TURN FILEDESC (Litleendian <-> Bigendian)              *)
(*****************************************************************************)
PROCEDURE CopyFileDesc(VAR a,b:FileDesc);
  TYPE TWOINT=ARRAY 2 OF INTEGER;
  VAR size:TWOINT;
BEGIN
b.name := a.name; b.name[21] := 0X;
b.time := SYSTEM.ROT(a.time,8);
b.date := SYSTEM.ROT(a.date,8);
b.head := SYSTEM.ROT(a.head,8);
size   := SYSTEM.VAL(TWOINT,a.size);
b.size := SYSTEM.LSH(LONG(SYSTEM.ROT(size[1],8)),16)+SYSTEM.ROT(size[0],8);
END CopyFileDesc;
PROCEDURE InitDir*;
  VAR t, d: LONGINT; i: INTEGER;
BEGIN
  trailer.name[0] := 0X;
  NEW(dir); dir.file.name[0] := 0FFX;
  dir.file.name[11] := 8X;                               (* def as vol label *)
  dir.next := dir; dir.prev := dir;
  usedF := 1; usedC := 7;
  FAT[0] := -1; FAT[1] := -1;
  i := 2;
  REPEAT FAT[i] := 0; FAT[i+1] := 0; INC(i,2) UNTIL i=720
END InitDir;
PROCEDURE Clusters (size:LONGINT):INTEGER;
BEGIN RETURN SHORT((size + 1023) DIV 1024);
END Clusters;
PROCEDURE findFile (name: ARRAY OF CHAR; VAR f: File);
BEGIN
  f := dir.next;
  WHILE f.file.name < name DO f := f.next END;
END findFile;
PROCEDURE ReadDir*;
  VAR f,g :File;
      n   :LONGINT;
      s,i,j,n0,n1:INTEGER;
      buf : ARRAY 1536 OF CHAR;
      dBuf: ARRAY 16 OF FileDesc;                  (* size(dBuf) = 512 Bytes *)
BEGIN
  stopMotor := OFF;                                    (* Motor laufen lassen *)
(* read boot sector *)
  GetSector(0, buf, 0);
  IF (buf[21] # 0F9X) & (buf[21] # 0E9X) THEN HALT(54) END;
(* read volum label *)
  GetSector(7, dBuf, 0);
  NEW(f); CopyFileDesc(dBuf[0],f.file);
  IF f.file.name[11] # 08X THEN HALT(54) END;            (* not volume label  *)
  IF (f.file.name[0] < 0E5X) & (f.file.name[0] # 0X) THEN HALT(54) END;
                                                         (* not Oberon Format *)
  f.file.name[0] := 0FFX;
(* read dir *)
  f.prev := f; f.next := f; dir := f;
  usedF := 1; usedC := 7;
  s := 7; j := 1;
  LOOP
    IF (dBuf[j].name[0] = 0X) OR (dBuf[j].name[0] = 0E5X) THEN EXIT END;
    NEW(f); CopyFileDesc(dBuf[j],f.file);
    findFile(f.file.name, g);
    f.next := g; g.prev.next := f; f.prev := g.prev; g.prev := f;
    INC(usedF); usedC := usedC + Clusters(f.file.size);
    INC(j);
    IF j = 16 THEN INC(s); j:=0;
      IF s = 14 THEN EXIT END;
      GetSector(s, dBuf, 0)
    END
  END;
(* read FAT *)
  GetSector(1, buf, 0);
  GetSector(2, buf, 512);
  GetSector(3, buf, 1024);
  stopMotor := ON; StopMotor;                           (* Motor ausschalten *)
  FAT[0] := -1; FAT[1] := -1;
  i := 2; j := 3;
  REPEAT
    n :=     ORD(buf[j+2]); n := n*256;
    n := n + ORD(buf[j+1]); n := n*256;
    n := n + ORD(buf[j]);
    n0 := SHORT (n MOD 4096); n1 := SHORT(n DIV 4096);
    IF n0 > 2047 THEN n0 := n0 - 4096 END;
    IF n1 > 2047 THEN n1 := n1 - 4096 END;
    FAT[i] := n0; FAT[i+1] := n1;
    i := i + 2; j := j + 3
  UNTIL i = 720
END ReadDir;
PROCEDURE WriteDir*;
  VAR f: File;
      n: LONGINT;
      s, i, j, n0, n1:INTEGER;
      buf : ARRAY 1536 OF CHAR;  (* 3*512 (sectors 1 2 3) *)
      dBuf: ARRAY 16 OF FileDesc;
BEGIN
  update  := OFF; stopMotor := OFF;
(* write boot sector *)
  buf[21] := 0F9X;
  PutSector(0, buf, 0);
(* write FAT *)
  buf[0] := 0F9X;
  buf[1] := 0FFX;
  buf[2] := 0FFX;
  i := 2; j := 3;
  REPEAT
    n0 := FAT[i]; n1 := FAT[i+1];
    IF n0<0 THEN n0 := n0 + 4096 END;
    IF n1<0 THEN n1 := n1 + 4096 END;
    n := n1; n := n*4096 + n0;
    buf[j]   := CHR(SHORT(n MOD 256)); n := n DIV 256;
    buf[j+1] := CHR(SHORT(n MOD 256)); n := n DIV 256;
    buf[j+2] := CHR(SHORT(n));
    i:=i+2; j:=j+3
  UNTIL i=720;
  PutSector(1, buf, 0);
  PutSector(2, buf, 512);
  PutSector(3, buf, 1024);
(* write dir *)
  s := 7; j := 0; f := dir;
  REPEAT
    CopyFileDesc(f.file,dBuf[j]); INC(j);
    IF j = 16 THEN PutSector(s, dBuf, 0); INC(s); j := 0 END;
    f := f.next
  UNTIL f = dir;
  IF s # 14 THEN
    CopyFileDesc(trailer,dBuf[j]);
    PutSector(s,dBuf,0)
  END;
  update   := ON; Update;
  stopMotor:= ON; StopMotor;
END WriteDir;
PROCEDURE GetData*(VAR date,time:LONGINT; VAR nofFiles,nofClusters:INTEGER);
BEGIN
  date := dir.file.date; time := LONG(dir.file.time)*2;
  nofFiles := usedF; nofClusters := usedC;
END GetData;
PROCEDURE Enumerate* (proc:EntryHandler);
  VAR f:File;
BEGIN f:=dir.next;
  WHILE f#dir DO
    proc(f.file.name, f.file.date, LONG(f.file.time)*2, f.file.size);
    f := f.next;
  END
END Enumerate;
(*===========================================================================*)
(*                              FILES PROCEDURES                             *)
(*===========================================================================*)
PROCEDURE readFile (f: File; g: Files.File);
  VAR Wg: Files.Rider;
      size: LONGINT; i: INTEGER;
      buf: ARRAY 1024 OF CHAR;
BEGIN
  Files.Set(Wg, g, 0);
  size := f.file.size;
  IF size # 0 THEN
    i := f.file.head;
    stopMotor := OFF;
    LOOP
      GetSector(10 + 2*i, buf, 0);
      GetSector(11 + 2*i, buf, 512);
      IF FAT[i] = -1 THEN EXIT END;
      Files.WriteBytes(Wg, buf, 1024);
      size := size - 1024; i := FAT[i]
    END;
    stopMotor := ON; StopMotor;
    Files.WriteBytes(Wg, buf, SHORT(size))
  END
END readFile;
PROCEDURE deleteFile (f:File);
  VAR i,j:INTEGER;
BEGIN
  f.prev.next := f.next; f.next.prev := f.prev;
  i := f.file.head;
  REPEAT j:=FAT[i]; FAT[i]:=0; i:=j UNTIL i=-1
END deleteFile;
PROCEDURE addFile (f: Files.File; g, h: File);
  VAR Rf: Files.Rider;
      need, i, j: INTEGER;
      buf: ARRAY 1024 OF CHAR;
BEGIN
  Files.Set(Rf, f, 0);
  need := Clusters(g.file.size);
  IF need # 0 THEN
    j := 2;
    WHILE FAT[j] # 0 DO INC(j) END;
    g.file.head := j;
    stopMotor := OFF; update := OFF;
    LOOP i := j;
      Files.ReadBytes(Rf, buf, 1024);
      PutSector(10 + 2*i, buf, 0);
      PutSector(11 + 2*i, buf, 512);
      DEC(need);
      IF need = 0 THEN EXIT END;
      INC(j);
      WHILE FAT[j] # 0 DO INC(j) END;
      FAT[i] := j
    END;
    FAT[i] := -1;
    update    := ON; Update;
    stopMotor := ON; StopMotor
  END;
  g.next := h; h.prev.next := g; g.prev := h.prev; h.prev := g
END addFile;
PROCEDURE ReadAll*;
  VAR f: File; g: Files.File; ch: CHAR;
BEGIN
  ReadDir;
  f := dir.next;
  WHILE f # dir DO
    g := Files.New(f.file.name); readFile(f, g); Files.Register(g); f := f.next
  END
END ReadAll;
PROCEDURE ReadFile* (name: ARRAY OF CHAR);
  VAR f: File; g: Files.File;
BEGIN
  findFile(name, f);
  IF f.file.name = name THEN
    g := Files.New(name); readFile(f, g); Files.Register(g); res := 0
  ELSE res := 1
  END
END ReadFile;
PROCEDURE WriteFile* (name: ARRAY OF CHAR);
  VAR f: Files.File; g, h: File; d, t: LONGINT; needC: INTEGER;
BEGIN res := 0;
  NEW(g); g.file.name[11] := 0X; (*attributes*)
  COPY(name, g.file.name);
  f := Files.Old(name);
  IF f # NIL THEN
    g.file.size := Files.Length(f);
    Kernel.GetClock(t, d);
    g.file.date := SHORT(d); g.file.time := SHORT(t DIV 2);
    findFile(g.file.name, h);
    IF h.file.name = g.file.name THEN
      needC := Clusters(g.file.size) - Clusters(h.file.size);
      IF usedC + needC <= 720 THEN
        deleteFile(h); addFile(f, g, h.next);
        usedC := usedC + needC
      ELSE res := 2
      END
    ELSE needC := Clusters(g.file.size);
      IF (usedF < 112) & (usedC + needC <= 720) THEN
        addFile(f, g, h);
        INC(usedF); usedC := usedC + needC
      ELSE res := 2
      END
    END
  ELSE res := 1
  END
END WriteFile;
PROCEDURE DeleteFile* (name: ARRAY OF CHAR);
  VAR g: File;
BEGIN
  findFile(name, g);
  IF g.file.name = name THEN
    deleteFile(g); DEC(usedF); usedC := usedC - Clusters(g.file.size); res := 0
  ELSE res := 1
  END
END DeleteFile;
(*===========================================================================*)
(*                           INITIAL ACTIONS                                 *)
(*===========================================================================*)
BEGIN
  Amiga.TermProcedure(Close);
  mfmioLI := 0; mfmPortLI := 0; mfmOpen := FALSE;         (* Initialisierung *)
  SetDrive(0); Reset
END Diskette.